home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 January / macformat-020.iso / Shareware City / Applications / Alpha.5.96 folder / Tcl / SystemCode / tcl.tcl < prev    next >
Encoding:
Text File  |  1994-09-04  |  2.0 KB  |  88 lines  |  [TEXT/ALFA]
  1. proc rebuildTclIndices {} {
  2.     set dir [pwd]
  3.     cd
  4.     message "Building SystemCode index…"
  5.     auto_mkindex :Tcl:SystemCode *.tcl
  6.     message "Building UserCode index…"
  7.     auto_mkindex :Tcl:UserCode *.tcl
  8.     message ""
  9.     cd $dir
  10. }
  11.  
  12.  
  13. proc tclMenuProc {menu item} {
  14.     global tclColoring
  15.  
  16.     eval $item
  17. }
  18.  
  19.  
  20. #===========================================================================
  21. # Debug a Tcl procedure.
  22. #===========================================================================
  23.  
  24. # Alpha TCL programming mode
  25.  
  26. proc traceTclProc {} {
  27.     global tclMenu
  28.     if {[llength [traceFunc status]]>2} {
  29.         markMenuItem $tclMenu {traceTclProc…} off
  30.         enableMenuItem $tclMenu dumpTraces off
  31.         dumpTraces [string trimright [lindex [traceFunc status] 3] {,}]
  32.         setWinInfo dirty 0
  33.         traceFunc off
  34.         return
  35.     }
  36.     if {[llength [winNames]] && [string length [set sel [getSelect]]]} {
  37.         set func [listpick -L $sel -p {Func Name:} [lsort -ignore [info procs]]]
  38.     } else {
  39.         set func [listpick -p {Func Name:} [lsort -ignore [info procs]]]
  40.     }
  41.     if {![string length $func]} return
  42.     traceFunc on $func ""
  43.     catch {markMenuItem $tclMenu {traceTclProc…} on}
  44.     enableMenuItem $tclMenu dumpTraces on
  45. }
  46.  
  47.  
  48. proc dumpTraces {{name ""}} {
  49.     if {![string length $name]} {
  50.         set name [string trimright [lindex [traceFunc status] 3] {,}]
  51.     }
  52.     if {![string length [set res [traceDump]]]} {
  53.         message "Trace buffer empty"
  54.     } else {
  55.         new -n "* Trace '$name' *"
  56.         insertText $res
  57.         setWinInfo dirty 0
  58.         goto 0 
  59.     }
  60. }
  61.  
  62. proc setTclMode {} {
  63.     changeMode "Tcl"
  64. }
  65.  
  66. #================================================================================
  67. proc TclMarkFile {} {
  68.     set end [maxPos]
  69.     set pos 0
  70.     set l {}
  71.     while {![catch {search -f 1 -r 1 -m 0 -i 0 {^proc} $pos} res]} {
  72.         set start [lindex $res 0]
  73.         set end [nextLineStart $start]
  74.         set text [lindex [getText $start $end] 1]
  75.         set pos $end
  76.         set inds($text) [lineStart [expr $start - 1]]
  77.     }
  78.  
  79.     if {[info exists inds]} {
  80.         foreach f [lsort [array names inds]] {
  81.             set next [nextLineStart $inds($f)]
  82.             setNamedMark $f $inds($f) $next $next
  83.         }
  84.     }
  85. }
  86.  
  87. proc dummyTcl {} {}
  88.